home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / RUNTIME.ZIP / RCOEXPR.R < prev    next >
Encoding:
Text File  |  1992-02-10  |  7.2 KB  |  280 lines
  1. /*
  2.  * File: rcoexpr.r -- co_init, co_chng
  3.  */
  4.  
  5. #if COMPILER
  6. static continuation coexpr_fnc;  /* function to call after switching stacks */
  7. #endif                    /* COMPILER */
  8.  
  9. /*
  10.  * co_init - use the contents of the refresh block to initialize the
  11.  *  co-expression.
  12.  */
  13. novalue co_init(sblkp)
  14. struct b_coexpr *sblkp;
  15. {
  16. #ifndef Coexpr
  17.    syserr("co_init() called, but co-expressions not implemented");
  18. #else                    /* Coexpr */
  19.    register word *newsp;
  20.    register struct b_refresh *rblkp;
  21.    register dptr dp, dsp;
  22.    int frame_size;
  23.    word stack_strt;
  24.    int na, nl, nt, i;
  25.  
  26.    /*
  27.     * Get pointer to refresh block and get number of arguments and locals.
  28.     */
  29.    rblkp = (struct b_refresh *)BlkLoc(sblkp->freshblk);
  30. #if COMPILER
  31.    na = rblkp->nargs;
  32.    nl = rblkp->nlocals;
  33.    nt = rblkp->ntemps;
  34. #else                    /* COMPILER */
  35.    na = (rblkp->pfmkr).pf_nargs + 1;
  36.    nl = (int)rblkp->numlocals;
  37. #endif                    /* COMPILER */
  38.  
  39. #if COMPILER
  40.    /*
  41.     * The C stack must be aligned on the correct boundry. For upgrowing
  42.     *  stacks, the C stack starts after the initial procedure frame of
  43.     *  the co-expression block. For downgrowing stacks, the C stack starts
  44.     *  at the last word of the co-expression block.
  45.     */
  46. #ifdef UpStack
  47.    frame_size = sizeof(struct p_frame) + sizeof(struct descrip) * (nl + na +
  48.       nt - 1) + rblkp->wrk_size;
  49.    stack_strt = (word)((char *)&sblkp->pf + frame_size + StackAlign*WordSize);
  50. #else                    /* UpStack */
  51.    stack_strt = (word)((char *)sblkp + stksize - WordSize);
  52. #endif                    /* UpStack */
  53.    sblkp->cstate[0] = stack_strt & ~(WordSize * StackAlign - 1);
  54.  
  55. #else                    /* COMPILER */
  56.  
  57.    /*
  58.     * The interpreter stack starts at word after co-expression stack block.
  59.     *  C stack starts at end of stack region on machines with down-growing C
  60.     *  stacks and somewhere in the middle of the region.
  61.     *
  62.     * The C stack is aligned on a doubleword boundary.    For upgrowing
  63.     *  stacks, the C stack starts in the middle of the stack portion
  64.     *  of the static block.  For downgrowing stacks, the C stack starts
  65.     *  at the last word of the static block.
  66.     */
  67.  
  68.    newsp = (word *)((char *)sblkp + sizeof(struct b_coexpr));
  69.  
  70. #ifdef UpStack
  71.    sblkp->cstate[0] =
  72.       ((word)((char *)sblkp + (stksize - sizeof(*sblkp))/2)
  73.          &~((word)WordSize*StackAlign-1));
  74. #else                    /* UpStack */
  75.    sblkp->cstate[0] =
  76.     ((word)((char *)sblkp + stksize - WordSize)
  77.            &~((word)WordSize*StackAlign-1));
  78. #endif                    /* UpStack */
  79.  
  80. #ifdef CoProcesses
  81.    sblkp->cstate[1] = 0;
  82. #endif
  83.  
  84.    sblkp->es_argp = (dptr)newsp;
  85.  
  86. #endif                    /* COMPILER */
  87.  
  88.    /*
  89.     * Copy arguments onto new stack.
  90.     */
  91.    dp = rblkp->elems;
  92. #if COMPILER
  93.    dsp = sblkp->pf.tend.d + nl;   /* args follow locals */
  94. #else                    /* COMPILER */
  95.    dsp = (dptr)newsp;
  96. #endif                    /* COMPILER */
  97.    for (i = 1; i <=  na; i++)
  98.       *dsp++ = *dp++;
  99.  
  100.    /*
  101.     * Set up state variables and initialize procedure frame.
  102.     */
  103. #if COMPILER
  104.    sblkp->es_pfp = &sblkp->pf;
  105.    sblkp->es_tend = &sblkp->pf.tend;
  106.    sblkp->es_argp = &sblkp->pf.tend.d[nl]; /* args are put after locals */
  107.    sblkp->pf.old_pfp = NULL;
  108.    sblkp->pf.rslt = NULL;
  109.    sblkp->pf.succ_cont = NULL;
  110.    sblkp->pf.tend.previous = NULL;
  111.    sblkp->pf.tend.num = nl + na + nt;
  112.    sblkp->es_actstk = NULL;
  113. #else                    /* COMPILER */
  114.    *((struct pf_marker *)dsp) = rblkp->pfmkr;
  115.    sblkp->es_pfp = (struct pf_marker *)dsp;
  116.    sblkp->es_tend = NULL;
  117.    dsp = (dptr)((word *)dsp + Vwsizeof(*pfp));
  118.    sblkp->es_ipc.opnd = rblkp->ep;
  119.    sblkp->es_gfp = 0;
  120.    sblkp->es_efp = 0;
  121.    sblkp->es_ilevel = 0;
  122. #endif                    /* COMPILER */
  123.    sblkp->tvalloc = NULL;
  124.  
  125.    /*
  126.     * Copy locals into the co-expression.
  127.     */
  128. #if COMPILER
  129.    dsp = sblkp->pf.tend.d;
  130. #endif                    /* COMPILER */
  131.    for (i = 1; i <= nl; i++)
  132.       *dsp++ = *dp++;
  133.  
  134. #if COMPILER
  135.    /*
  136.     * Initialize temporary variables.
  137.     */
  138.    for (i = 1; i <= nt; i++)
  139.       *dsp++ = nulldesc;
  140. #else                    /* COMPILER */
  141.    /*
  142.     * Push two null descriptors on the stack.
  143.     */
  144.    *dsp++ = nulldesc;
  145.    *dsp++ = nulldesc;
  146.  
  147.    sblkp->es_sp = (word *)dsp - 1;
  148. #endif                    /* COMPILER */
  149.  
  150. #endif                    /* Coexpr */
  151.    }
  152.  
  153. /*
  154.  * co_chng - high-level co-expression context switch.
  155.  */
  156. int co_chng(ncp, valloc, rsltloc, swtch_typ, first)
  157. struct b_coexpr *ncp;
  158. struct descrip *valloc; /* location of value being transmitted */
  159. struct descrip *rsltloc;/* location to put result */
  160. int swtch_typ;          /* A_Coact, A_Coret, A_Cofail, or A_MTEvent */
  161. int first;
  162. {
  163. #ifndef Coexpr
  164.    syserr("co_chng() called, but coexpressions not implemented");
  165. #else                        /* Coexpr */
  166.    register struct b_coexpr *ccp;
  167.    struct descrip rval;
  168.    static int coexp_act;     /* used to pass signal across activations */
  169.                              /* back to whomever activates, if they care */
  170.  
  171.    ccp = (struct b_coexpr *)BlkLoc(k_current);
  172.  
  173. #if !COMPILER
  174. #ifdef EventMon
  175.    switch(swtch_typ) {
  176.       case A_Coact:  EVValX(ncp,E_Coact);  break;
  177.       case A_Coret:  EVValX(ncp,E_Coret);  break;
  178.       case A_Cofail: EVValX(ncp,E_Cofail); break;
  179.       }
  180. #endif                        /* EventMon */
  181. #endif                    /* COMPILER */
  182.  
  183.    /*
  184.     * Determine if we need to transmit a value.
  185.     */
  186.    if (ncp->tvalloc != NULL && valloc != NULL) {
  187.  
  188. #if COMPILER
  189.       deref(valloc, ncp->tvalloc);
  190. #else                    /* COMPILER */
  191.    /*
  192.     * Determine if we need to dereference transmited value. 
  193.     */
  194.       rval = *valloc;
  195.       if (Var(rval))
  196.          retderef(&rval, &rval, (word *)ccp);
  197.  
  198.       *ncp->tvalloc = rval;
  199. #endif                    /* COMPILER */
  200.  
  201.       }
  202.    ncp->tvalloc = NULL;
  203.    ccp->tvalloc = rsltloc;
  204.  
  205.    /*
  206.     * Save state of current co-expression.
  207.     */
  208.    ccp->es_pfp = pfp;
  209.    ccp->es_argp = argp;
  210.    ccp->es_tend = tend;
  211.  
  212. #if !COMPILER
  213.    ccp->es_efp = efp;
  214.    ccp->es_gfp = gfp;
  215.    ccp->es_ipc = ipc;
  216.    ccp->es_sp = sp;
  217.    ccp->es_ilevel = ilevel;
  218. #endif                    /* COMPILER */
  219.  
  220. #if COMPILER
  221.    if (line_info) {
  222.       ccp->file_name = file_name;
  223.       ccp->line_num = line_num;
  224.       file_name = ncp->file_name;
  225.       line_num = ncp->line_num;
  226.       }
  227. #endif                    /* COMPILER */
  228.  
  229. #if COMPILER
  230.    if (debug_info)
  231. #endif                    /* COMPILER */
  232.       if (k_trace)
  233.          cotrace(ccp, ncp, swtch_typ, valloc);
  234.  
  235.    /*
  236.     * Establish state for new co-expression.
  237.     */
  238.    pfp = ncp->es_pfp;
  239.    argp = ncp->es_argp;
  240.    tend = ncp->es_tend;
  241. #if !COMPILER
  242.    efp = ncp->es_efp;
  243.    gfp = ncp->es_gfp;
  244.    ipc = ncp->es_ipc;
  245.    sp = ncp->es_sp;
  246.    ilevel = (int)ncp->es_ilevel;
  247. #endif                    /* COMPILER */
  248.  
  249. #if !COMPILER
  250. #endif                    /* COMPILER */
  251.  
  252.    BlkLoc(k_current) = (union block *)ncp;
  253.  
  254. #if COMPILER
  255.    coexpr_fnc = ncp->fnc;
  256. #endif                    /* COMPILER */
  257.  
  258.    coexp_act = swtch_typ;
  259.    coswitch(ccp->cstate, ncp->cstate,first);
  260.    return coexp_act;
  261. #endif                        /* Coexpr */
  262.    }
  263.  
  264. #ifdef Coexpr
  265. /*
  266.  * new_context - determine what function to call to execute the new
  267.  *  co-expression; this completes the context switch.
  268.  */
  269. novalue new_context(fsig,cargp)
  270. int fsig;
  271. dptr cargp;
  272.    {
  273. #if COMPILER
  274.    (*coexpr_fnc)();
  275. #else                    /* COMPILER */
  276.    interp(fsig, cargp);
  277. #endif                    /* COMPILER */
  278.    }
  279. #endif                    /* Coexpr */
  280.